df_ger_socdist$date %>% summary()
Min. 1st Qu. Median Mean 3rd Qu. Max.
"2020-02-25" "2020-03-11" "2020-03-27" "2020-03-27" "2020-04-12" "2020-04-27"
# prevalence
df_ger_covid_clean <- df_ger_covid %>% mutate(date = as.Date(date, "%d%b%Y"),
kreis = as.character(kreis)) %>%
filter(date >= '2020-03-09' & date <= '2020-03-31') %>%
group_by(kreis) %>%
mutate(time = row_number()) %>%
ungroup() %>%
dplyr::select(-runday, -kreis_name, -ewz, -shape__area,
-cumcase, -anzahlfall, -popdens) %>%
dplyr::rename(pers_o = open,
pers_c = sci,
pers_e = extra,
pers_a = agree,
pers_n = neuro)
df_ger_covid_clean %>% head()
# social distancing
df_ger_socdist_clean <- df_ger_socdist %>%
filter(date >= '2020-03-09' & date <= '2020-03-31') %>%
mutate(kreis = as.character(kreis)) %>%
group_by(kreis) %>%
mutate(time = row_number()) %>%
ungroup() %>%
rename(socdist_single_tile = all_day_ratio_single_tile_users) %>%
select(kreis, time, socdist_single_tile)
df_ger_socdist_clean %>% head()
NA
# controls
df_ger_ctrl_clean <- df_ger_ctrl %>% select(-kreis_nme) %>%
mutate(kreis = as.character(kreis),
popdens = popdens %>%
as.character() %>%
str_replace('\\.', '')%>%
as.numeric())
df_ger_ctrl_clean
NA
NA
# merge
df_ger <- df_ger_covid_clean %>%
plyr::join(df_ger_socdist_clean, by = c('kreis', 'time')) %>%
inner_join(df_ger_ctrl_clean, by = 'kreis')
df_ger %>% ggplot(aes(x=time, y=rate_day)) +
geom_point(aes(col=kreis, size=popdens)) +
geom_smooth(method="loess", se=T) +
theme(legend.position="none") +
ggtitle("Overall prevalence over time")
pers <- c('pers_o', 'pers_c', 'pers_e', 'pers_a', 'pers_n')
for (i in pers){
gg <- df_ger %>% mutate(prev_tail = cut(.[[i]],
breaks = c(-Inf, quantile(.[[i]], 0.2), quantile(.[[i]], 0.8), Inf),
labels = c('lower tail', 'center', 'upper tail'))) %>%
filter(prev_tail != 'center') %>%
ggplot(aes(x=time, y=rate_day)) +
geom_point(aes(col=kreis, size=popdens)) +
geom_smooth(method="loess", se=T) +
facet_wrap(~prev_tail) +
theme(legend.position="none") +
ggtitle(i)
print(gg)
}
weekend <- c(6, 7, 13, 14, 20, 21)
df_ger_loess <- df_ger %>% filter(!time %in% weekend) %>%
split(.$kreis) %>%
map(~ loess(socdist_single_tile ~ time, data = .)) %>%
map(predict, 1:23) %>%
bind_rows() %>%
gather(key = 'kreis', value = 'loess') %>%
group_by(kreis) %>%
mutate(time = row_number())
df_ger <- df_ger %>% merge(df_ger_loess, by=c('kreis', 'time')) %>%
mutate(socdist_single_tile_clean = ifelse(time %in% weekend, loess,
socdist_single_tile)) %>%
arrange(kreis, time)
df_ger %>% ggplot(aes(x=time, y=loess, group=kreis)) +
geom_line()
NA
NA
df_ger %>% ggplot(aes(x=time, y=socdist_single_tile_clean)) +
geom_point(aes(col=kreis, size=popdens)) +
geom_smooth(method="loess", se=T) +
theme(legend.position="none") +
ggtitle("Overall social distancing (single tile) over time")
pers <- c('pers_o', 'pers_c', 'pers_e', 'pers_a', 'pers_n')
for (i in pers){
gg <- df_ger %>% mutate(prev_tail = cut(.[[i]],
breaks = c(-Inf, quantile(.[[i]], 0.2), quantile(.[[i]], 0.8), Inf),
labels = c('lower tail', 'center', 'upper tail'))) %>%
filter(prev_tail != 'center') %>%
ggplot(aes(x=time, y=socdist_single_tile_clean)) +
geom_point(aes(col=kreis, size=popdens)) +
geom_smooth(method="loess", se=T) +
facet_wrap(~prev_tail) +
theme(legend.position="none") +
ggtitle(i)
print(gg)
}
df_ger <- df_ger %>% mutate(socdist_single_tile = socdist_single_tile_clean) %>%
select(-loess, -socdist_single_tile_clean)
df_ger %>% group_by(kreis) %>%
summarize_if(is.numeric, mean) %>%
select(-kreis, -time) %>%
cor(use='pairwise.complete') %>%
round(3)
pers_e pers_a pers_c pers_n pers_o rate_day socdist_single_tile women academics
pers_e 1.000 0.223 0.255 -0.375 0.277 0.168 0.138 -0.050 0.196
pers_a 0.223 1.000 0.347 -0.379 0.167 0.135 -0.015 0.037 0.233
pers_c 0.255 0.347 1.000 -0.373 -0.063 -0.010 0.020 -0.002 0.027
pers_n -0.375 -0.379 -0.373 1.000 -0.046 -0.127 -0.142 0.053 -0.147
pers_o 0.277 0.167 -0.063 -0.046 1.000 0.115 0.104 0.195 0.501
rate_day 0.168 0.135 -0.010 -0.127 0.115 1.000 0.228 -0.098 0.106
socdist_single_tile 0.138 -0.015 0.020 -0.142 0.104 0.228 1.000 -0.006 0.026
women -0.050 0.037 -0.002 0.053 0.195 -0.098 -0.006 1.000 0.335
academics 0.196 0.233 0.027 -0.147 0.501 0.106 0.026 0.335 1.000
cdu 0.090 0.024 -0.017 -0.032 -0.151 0.316 0.232 -0.404 -0.407
afd -0.152 0.008 0.132 0.113 -0.213 -0.212 -0.464 -0.107 -0.177
hospital_beds -0.037 0.004 -0.157 0.111 0.281 -0.060 -0.228 0.456 0.383
tourism_beds -0.131 -0.104 -0.053 0.034 -0.099 -0.064 0.005 0.003 -0.167
gdp 0.141 0.044 -0.052 -0.117 0.343 0.127 0.007 0.060 0.534
manufact -0.042 -0.040 -0.042 0.003 -0.073 0.136 -0.136 -0.313 -0.145
airport -0.188 -0.167 -0.112 0.171 -0.222 -0.031 -0.169 -0.208 -0.416
age -0.289 -0.080 0.125 0.178 -0.368 -0.299 -0.267 0.149 -0.492
popdens 0.127 -0.025 -0.084 -0.007 0.415 -0.018 0.065 0.350 0.620
cdu afd hospital_beds tourism_beds gdp manufact airport age popdens
pers_e 0.090 -0.152 -0.037 -0.131 0.141 -0.042 -0.188 -0.289 0.127
pers_a 0.024 0.008 0.004 -0.104 0.044 -0.040 -0.167 -0.080 -0.025
pers_c -0.017 0.132 -0.157 -0.053 -0.052 -0.042 -0.112 0.125 -0.084
pers_n -0.032 0.113 0.111 0.034 -0.117 0.003 0.171 0.178 -0.007
pers_o -0.151 -0.213 0.281 -0.099 0.343 -0.073 -0.222 -0.368 0.415
rate_day 0.316 -0.212 -0.060 -0.064 0.127 0.136 -0.031 -0.299 -0.018
socdist_single_tile 0.232 -0.464 -0.228 0.005 0.007 -0.136 -0.169 -0.267 0.065
women -0.404 -0.107 0.456 0.003 0.060 -0.313 -0.208 0.149 0.350
academics -0.407 -0.177 0.383 -0.167 0.534 -0.145 -0.416 -0.492 0.620
cdu 1.000 -0.341 -0.309 0.210 -0.093 0.229 0.277 -0.167 -0.473
afd -0.341 1.000 0.011 -0.044 -0.223 0.120 0.190 0.583 -0.211
hospital_beds -0.309 0.011 1.000 -0.039 0.400 0.022 -0.046 -0.107 0.390
tourism_beds 0.210 -0.044 -0.039 1.000 -0.113 -0.102 0.357 0.198 -0.225
gdp -0.093 -0.223 0.400 -0.113 1.000 0.546 -0.165 -0.483 0.474
manufact 0.229 0.120 0.022 -0.102 0.546 1.000 0.169 -0.063 -0.137
airport 0.277 0.190 -0.046 0.357 -0.165 0.169 1.000 0.316 -0.438
age -0.167 0.583 -0.107 0.198 -0.483 -0.063 0.316 1.000 -0.461
popdens -0.473 -0.211 0.390 -0.225 0.474 -0.137 -0.438 -0.461 1.000
# function calculates all relevant models
run_models <- function(y, lvl1_x, lvl2_x, lvl2_id, data, ctrls=F){
# subset data
data = data %>%
dplyr::select(all_of(y), all_of(lvl1_x), all_of(lvl2_x), all_of(lvl2_id),
popdens, rate_day)
data = data %>%
dplyr::rename(y = all_of(y),
lvl1_x = all_of(lvl1_x),
lvl2_x = all_of(lvl2_x),
lvl2_id = all_of(lvl2_id)
)
# configure optimization procedure
ctrl_config <- lmeControl(opt = 'optim', maxIter = 100, msMaxIter = 100)
# baseline
baseline <- lme(fixed = y ~ 1, random = ~ 1 | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# random intercept fixed slope
random_intercept <- lme(fixed = y ~ lvl1_x + lvl2_x,
random = ~ 1 | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# random intercept random slope
random_slope <- lme(fixed = y ~ lvl1_x + lvl2_x,
random = ~ lvl1_x | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# cross level interaction
interaction <- lme(fixed = y ~ lvl1_x * lvl2_x,
random = ~ lvl1_x | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# create list with results
results <- list('baseline' = baseline,
"random_intercept" = random_intercept,
"random_slope" = random_slope,
"interaction" = interaction)
if (ctrls == 'dem' | ctrls == 'prev'){
# random intercept random slope
random_slope_ctrl_dem <- lme(fixed = y ~ lvl1_x + lvl2_x + popdens,
random = ~ lvl1_x | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# cross level interaction
interaction_ctrl_main_dem <- lme(fixed = y ~ lvl1_x * lvl2_x + popdens,
random = ~ lvl1_x | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# cross level interaction
interaction_ctrl_int_dem <- lme(fixed = y ~ lvl1_x * lvl2_x + lvl1_x * popdens,
random = ~ lvl1_x | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# create list with results
results <- list('baseline' = baseline,
"random_intercept" = random_intercept,
"random_slope" = random_slope,
"interaction" = interaction,
"random_slope_ctrl_dem" = random_slope_ctrl_dem,
"interaction_ctrl_main_dem" = interaction_ctrl_main_dem,
"interaction_ctrl_int_dem" = interaction_ctrl_int_dem)
}
if (ctrls == 'prev'){
# random intercept random slope
random_slope_ctrl_prev <- lme(fixed = y ~ lvl1_x + lvl2_x + popdens + rate_day,
random = ~ lvl1_x + rate_day | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# cross level interaction
interaction_ctrl_main_prev <- lme(fixed = y ~ lvl1_x * lvl2_x + popdens + rate_day,
random = ~ lvl1_x | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# cross level interaction
interaction_ctrl_int_prev<- lme(fixed = y ~ lvl1_x * lvl2_x + lvl1_x * popdens + rate_day,
random = ~ lvl1_x + rate_day | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# create list with results
results <- list('baseline' = baseline,
"random_intercept" = random_intercept,
"random_slope" = random_slope,
"interaction" = interaction,
"random_slope_ctrl_dem" = random_slope_ctrl_dem,
"interaction_ctrl_main_dem" = interaction_ctrl_main_dem,
"interaction_ctrl_int_dem" = interaction_ctrl_int_dem,
"random_slope_ctrl_prev" = random_slope_ctrl_prev,
"interaction_ctrl_main_prev" = interaction_ctrl_main_prev,
"interaction_ctrl_int_prev" = interaction_ctrl_int_prev)
}
if(ctrls == 'exp'){
# random intercept random slope
random_slope_exp <- lme(fixed = y ~ (lvl1_x + I(lvl1_x^2)) + lvl2_x,
random = ~ (lvl1_x + I(lvl1_x^2)) | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# cross level interaction
interaction_exp <- lme(fixed = y ~ (lvl1_x + I(lvl1_x^2)) * lvl2_x,
random = ~ (lvl1_x + I(lvl1_x^2)) | lvl2_id,
data = data,
correlation = corAR1(),
control = ctrl_config,
method = 'ML')
# create list with results
results <- list('baseline' = baseline,
"random_intercept" = random_intercept,
"random_slope" = random_slope,
"interaction" = interaction,
"random_slope_exp" = random_slope_exp,
"interaction_exp" = interaction_exp)
}
return(results)
}
# extracts table with coefficients and tests statistics
extract_results <- function(models) {
models_summary <- models %>%
map(summary) %>%
map("tTable") %>%
map(as.data.frame) %>%
map(round, 10)
# %>% map(~ .[str_detect(rownames(.), 'Inter|lvl'),])
return(models_summary)
}
compare_models <- function(models) {
mdl_names <- models %>% names()
str = ''
for (i in mdl_names){
mdl_str <- paste('models$', i, sep = '')
if(i == 'baseline'){
str <- mdl_str
}else{
str <- paste(str, mdl_str, sep=', ')
}
}
anova_str <- paste0('anova(', str, ')')
mdl_comp <- eval(parse(text=anova_str))
rownames(mdl_comp) = mdl_names
return(mdl_comp)
}
lvl2_scaled <- df_ger %>%
dplyr::select(-time, -rate_day, -socdist_single_tile, -date) %>%
distinct() %>%
mutate_at(vars(-kreis), scale)
lvl1_scaled <- df_ger %>% select(kreis, time, rate_day, socdist_single_tile) %>%
mutate_at(vars(-kreis, -time), scale)
df_ger_scaled <- plyr::join(lvl1_scaled, lvl2_scaled, by = 'kreis')
head(df_ger_scaled)
NA
NA
models_o_covid <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_o',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'dem')
extract_results(models_o_covid)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_ctrl_dem
$interaction_ctrl_main_dem
$interaction_ctrl_int_dem
compare_models(models_o_covid)
NA
models_c_covid <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_c',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'dem')
extract_results(models_c_covid)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_ctrl_dem
$interaction_ctrl_main_dem
$interaction_ctrl_int_dem
compare_models(models_c_covid)
NA
NA
models_e_covid <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_e',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'dem')
extract_results(models_e_covid)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_ctrl_dem
$interaction_ctrl_main_dem
$interaction_ctrl_int_dem
compare_models(models_e_covid)
NA
NA
models_a_covid <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_a',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'dem')
extract_results(models_a_covid)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_ctrl_dem
$interaction_ctrl_main_dem
$interaction_ctrl_int_dem
compare_models(models_a_covid)
NA
NA
models_n_covid <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_n',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'dem')
extract_results(models_n_covid)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_ctrl_dem
$interaction_ctrl_main_dem
$interaction_ctrl_int_dem
compare_models(models_n_covid)
NA
NA
models_o_covid_exp <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_o',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'exp')
extract_results(models_o_covid_exp)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_exp
$interaction_exp
compare_models(models_o_covid_exp)
NA
models_c_covid_exp <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_c',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'exp')
extract_results(models_c_covid_exp)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_exp
$interaction_exp
compare_models(models_c_covid_exp)
NA
models_e_covid_exp <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_e',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'exp')
extract_results(models_e_covid_exp)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_exp
$interaction_exp
compare_models(models_e_covid_exp)
NA
models_a_covid_exp <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_a',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'exp')
extract_results(models_a_covid_exp)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_exp
$interaction_exp
compare_models(models_a_covid_exp)
NA
models_n_covid_exp <-run_models(y = 'rate_day',
lvl1_x = 'time',
lvl2_x = 'pers_n',
lvl2_id = 'kreis',
data = df_ger_scaled,
ctrls = 'exp')
extract_results(models_n_covid_exp)
$baseline
$random_intercept
$random_slope
$interaction
$random_slope_exp
$interaction_exp
compare_models(models_n_covid_exp)
NA
summary_table <- function(models, dv_name, prev=F){
temp_df_ctrl_main <- NULL
temp_df_ctrl_int <- NULL
temp_df_ctrl_int_prev <- NULL
for (i in models){
results <- i %>% extract_results()
results_ctrl_main <- results$interaction_ctrl_main_dem['lvl1_x:lvl2_x',]
temp_df_ctrl_main <- temp_df_ctrl_main %>% rbind(results_ctrl_main)
results_ctrl_int <- results$interaction_ctrl_int_dem['lvl1_x:lvl2_x',]
temp_df_ctrl_int <- temp_df_ctrl_int %>% rbind(results_ctrl_int)
if(prev){
results_ctrl_int_prev <- results$interaction_ctrl_int_prev['lvl1_x:lvl2_x',]
temp_df_ctrl_int_prev <- temp_df_ctrl_int_prev %>% rbind(results_ctrl_int_prev)
}
}
names_ctrl_main <- paste0(dv_name, '~', c('o', 'c', 'e', 'a', 'n'), '*time', '_crtl_popdens')
rownames(temp_df_ctrl_main) <- names_ctrl_main
names_ctrl_int <- paste0(dv_name, '~', c('o', 'c', 'e', 'a', 'n'), '*time', '_crtl_popdens*time')
rownames(temp_df_ctrl_int) <- names_ctrl_int
if(prev){
names_ctrl_int_prev <- paste0(dv_name, '~', c('o', 'c', 'e', 'a', 'n'), '*time', '_crtl_popdens*time_prev')
rownames(temp_df_ctrl_int_prev) <- names_ctrl_int_prev
sum_tab <- rbind(temp_df_ctrl_main, temp_df_ctrl_int, temp_df_ctrl_int_prev) %>% round(4)
}else{
sum_tab <- rbind(temp_df_ctrl_main, temp_df_ctrl_int) %>% round(4)
}
return(sum_tab)
}
# prevalence
models_prev <- list(models_o_covid,
models_c_covid,
models_e_covid,
models_a_covid,
models_n_covid)
sum_tab_prev <- summary_table(models_prev, dv_name = 'prev')
write.table(sum_tab_prev, quote=F)
Value Std.Error DF t-value p-value
prev~o*time_crtl_popdens 0.0072 0.0029 8798 2.4355 0.0149
prev~c*time_crtl_popdens 3e-04 0.003 8798 0.0945 0.9247
prev~e*time_crtl_popdens 0.0099 0.0029 8798 3.4019 7e-04
prev~a*time_crtl_popdens 0.0092 0.0029 8798 3.1338 0.0017
prev~n*time_crtl_popdens -0.0072 0.0029 8798 -2.4642 0.0137
prev~o*time_crtl_popdens*time 0.0099 0.0032 8797 3.0928 0.002
prev~c*time_crtl_popdens*time 1e-04 0.003 8797 0.0219 0.9825
prev~e*time_crtl_popdens*time 0.0104 0.0029 8797 3.5486 4e-04
prev~a*time_crtl_popdens*time 0.0091 0.0029 8797 3.1155 0.0018
prev~n*time_crtl_popdens*time -0.0073 0.0029 8797 -2.4725 0.0134
# social distancing
models_socdist <- list(models_o_socdist,
models_c_socdist,
models_e_socdist,
models_a_socdist,
models_n_socdist)
sum_tab_socdist <- summary_table(models_socdist, dv_name = 'socdist', prev=T)
write.table(sum_tab_socdist, quote=F)
Value Std.Error DF t-value p-value
socdist~o*time_crtl_popdens 0.0059 0.0016 8798 3.7756 2e-04
socdist~c*time_crtl_popdens -2e-04 0.0016 8798 -0.097 0.9227
socdist~e*time_crtl_popdens 0.0038 0.0016 8798 2.4132 0.0158
socdist~a*time_crtl_popdens 0.0022 0.0016 8798 1.4111 0.1582
socdist~n*time_crtl_popdens -0.0021 0.0016 8798 -1.3383 0.1808
socdist~o*time_crtl_popdens*time 0.0044 0.0017 8797 2.5576 0.0106
socdist~c*time_crtl_popdens*time 3e-04 0.0016 8797 0.1967 0.8441
socdist~e*time_crtl_popdens*time 0.0031 0.0016 8797 1.9928 0.0463
socdist~a*time_crtl_popdens*time 0.0023 0.0016 8797 1.5053 0.1323
socdist~n*time_crtl_popdens*time -0.0021 0.0016 8797 -1.3209 0.1866
socdist~o*time_crtl_popdens*time_prev 0.0033 0.0017 8796 1.9363 0.0529
socdist~c*time_crtl_popdens*time_prev 3e-04 0.0015 8796 0.1949 0.8455
socdist~e*time_crtl_popdens*time_prev 0.002 0.0016 8796 1.2797 0.2007
socdist~a*time_crtl_popdens*time_prev 0.0013 0.0015 8796 0.8453 0.398
socdist~n*time_crtl_popdens*time_prev -0.0012 0.0015 8796 -0.8056 0.4205
# slope prevalence
df_ger_slope_prev <- df_ger %>% split(.$kreis) %>%
map(~ lm(rate_day ~ time, data = .)) %>%
map(coef) %>%
map_dbl('time') %>%
as.data.frame() %>%
rownames_to_column('kreis') %>%
rename(slope_prev = '.')
# merge with control variables
df_ger_slope_prev <- df_ger %>% select(-time, -date, -rate_day, -socdist_single_tile) %>%
distinct() %>%
inner_join(df_ger_slope_prev, by = 'kreis') %>%
drop_na()
df_ger_slope_prev
NA
df_ger_slope_prev %>% ggplot(aes(slope_prev)) + geom_histogram(bins = 100)
df_ger_slope_socdist %>% ggplot(aes(slope_socdist)) + geom_histogram(bins = 100)
NA
NA
ctrls <- cforest_unbiased(ntree=500, mtry=5)
crf_o_fit_prev <- cforest(slope_prev ~ pers_o + women + academics +
hospital_beds + gdp + manufact +
airport + age + popdens,
df_ger_slope_prev[-1],
controls = ctrls)
crf_o_varimp_prev <- varimp(crf_o_fit_prev, nperm = 1)
crf_o_varimp_cond_prev <- varimp(crf_o_fit_prev, conditional = T, nperm = 1)
crf_o_varimp_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
crf_o_varimp_cond_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
ctrls <- cforest_unbiased(ntree=500, mtry=5)
crf_c_fit_prev <- cforest(slope_prev ~ pers_c + women + academics +
hospital_beds + gdp + manufact +
airport + age + popdens,
df_ger_slope_prev[-1],
controls = ctrls)
crf_c_varimp_prev <- varimp(crf_c_fit_prev, nperm = 1)
crf_c_varimp_cond_prev <- varimp(crf_c_fit_prev, conditional = T, nperm = 1)
crf_c_varimp_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
crf_c_varimp_cond_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
ctrls <- cforest_unbiased(ntree=500, mtry=5)
crf_e_fit_prev <- cforest(slope_prev ~ pers_e + women + academics +
hospital_beds + gdp + manufact +
airport + age + popdens,
df_ger_slope_prev[-1],
controls = ctrls)
crf_e_varimp_prev <- varimp(crf_e_fit_prev, nperm = 1)
crf_e_varimp_cond_prev <- varimp(crf_e_fit_prev, conditional = T, nperm = 1)
crf_e_varimp_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
crf_e_varimp_cond_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
ctrls <- cforest_unbiased(ntree=500, mtry=5)
crf_a_fit_prev <- cforest(slope_prev ~ pers_a + women + academics +
hospital_beds + gdp + manufact +
airport + age + popdens,
df_ger_slope_prev[-1],
controls = ctrls)
crf_a_varimp_prev <- varimp(crf_a_fit_prev, nperm = 1)
crf_a_varimp_cond_prev <- varimp(crf_a_fit_prev, conditional = T, nperm = 1)
crf_a_varimp_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
crf_a_varimp_cond_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
ctrls <- cforest_unbiased(ntree=500, mtry=5)
crf_n_fit_prev <- cforest(slope_prev ~ pers_n + women + academics +
hospital_beds + gdp + manufact +
airport + age + popdens,
df_ger_slope_prev[-1],
controls = ctrls)
crf_n_varimp_prev <- varimp(crf_n_fit_prev, nperm = 1)
crf_n_varimp_cond_prev <- varimp(crf_n_fit_prev, conditional = T, nperm = 1)
crf_n_varimp_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
crf_n_varimp_cond_prev %>% as.data.frame() %>% rownames_to_column('variable') %>%
ggplot(aes(x=variable, y=.)) +
geom_bar(stat = 'identity') +
theme(axis.text.x = element_text(angle = 90))
social distancing ~ openness